home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s1.arc / GETAUTOF.MOD < prev    next >
Encoding:
Text File  |  1987-03-26  |  1.9 KB  |  61 lines
  1. PROCEDURE Get_Auto_File_Name(     Keybrd_Line : AnyStr;
  2.                               VAR FileName    : AnyStr );
  3.  
  4. VAR
  5.    Dot_Pos : INTEGER;
  6.    I       : INTEGER;
  7.    K       : INTEGER;
  8.    L       : INTEGER;
  9.  
  10. (* STRUCTURED *) CONST
  11.    Legal_File_Name_Chars : SET OF CHAR = ['A'..'Z','0'..'9','$','&',
  12.                                           '#','%','''','(',')','-',
  13.                                           '@','^','{','}','~','`',
  14.                                           '!','_'];
  15.  
  16. BEGIN (* Get_Auto_File_Name *)
  17.  
  18.                                    (* Null file name to start *)
  19.    FileName[0] := #0;
  20.                                    (* No '.' in Keybrd_Line --    *)
  21.                                    (* no file name then, so exit. *)
  22.    L := LENGTH( Keybrd_Line );
  23.  
  24.    IF ( L = 0 ) THEN EXIT;
  25.  
  26.    Dot_Pos := POS( '.' , Keybrd_Line );
  27.  
  28.    IF ( Dot_Pos > 0 ) THEN
  29.       BEGIN
  30.                                    (* Pick up first part of file name *)
  31.          I := Dot_Pos - 1;
  32.          K := 8;
  33.          WHILE ( ( I > 0 ) AND
  34.                  ( K > 0 ) AND
  35.                  ( UpCase( Keybrd_Line[I] ) IN Legal_File_Name_Chars ) ) DO
  36.             BEGIN
  37.                FileName := Keybrd_Line[I] + FileName;
  38.                I        := PRED( I );
  39.                K        := PRED( K );
  40.             END;
  41.                                    (* Insert '.' *)
  42.  
  43.          FileName := FileName + '.';
  44.  
  45.                                    (* Pick up file extension *)
  46.          I := Dot_Pos + 1;
  47.          K := 3;
  48.  
  49.          WHILE ( ( I <= L ) AND
  50.                  ( K >  0 ) AND
  51.                  ( UpCase( Keybrd_Line[I] ) IN Legal_File_Name_Chars ) ) DO
  52.             BEGIN
  53.                FileName := FileName + Keybrd_Line[I];
  54.                I        := SUCC( I );
  55.                K        := PRED( K );
  56.             END;
  57.  
  58.       END;
  59.  
  60. END   (* Get_Auto_File_Name *);
  61.